
(*
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$$$
$$$   PASCAL FILE NAME .................... TK.PART2.TEXT
$$$   PASCAL FILE TYPE .................... TEXT
$$$   PASCAL FILE DATE .................... 1985-MAY-31
$$$
$$$   PASCAL VOLUME NAME .................. TK
$$$
$$$   DISK IMAGE NAME ..................... A2PASDT1
$$$
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$$$
$$$   DISK IMAGE COMMENT:
$$$
$$$     APPLE II PASCAL DESKTOP TOOLKIT - MOUSE GRAPHICS - 1988 - 1/4
$$$
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
*)


procedure       IntStr    (    K : integer;
                           var S : string);
    var
        negative : boolean;
        d_str : string[1];
    begin
      negative := K < 0;
      K := abs(K);
      s := '';
      d_str := '0';
      
      {$R-}
      repeat
        d_str[1] := chr(ord('0') + k mod 10);
        S := concat(d_str,S);
        K := K div 10;
      until K = 0;
      if negative then s := concat('-',s);
      {$R+}
    end;
    
procedure       DrawInt   (x : integer);
    var
        s : string;
    begin
      intstr(x,s);
      drawtext(s);
    end;

procedure       NewLine     (var x,y : integer);
    const
       linesep = 10;
    begin
      y := y + linesep;
      moveto(x,y);
    end;
    
procedure       DispPort  (    x,y : integer; { location to start display }
                           var p : grafport);

{ Prints the values in the port P to the file f }
{ Very useful when debugging. }
    var 
        k : integer;
        s : string;
    
        procedure     Dispmap(var map : mapinfo);
            begin
              moveto(x,y);
              drawtext ('ViewX, ViewY:  ');
              drawint(map.viewloc.x);
              drawtext(',');
              drawint(map.viewloc.y);
              
              newline(x,y);
              drawtext('Mapbits:  ');
              drawint(map.mapbits);
              
              newline(x,y);
              drawtext( 'Mapwidth:  ');
              drawint(map.mapwidth);
              
              newline(x,y);
              drawtext('ClipRect:  ');
              drawint(map.maprect.left);
              drawtext(',');
              drawint(map.maprect.top);
              
              newline(x,y);
              drawtext('ClipRect:  ');
              drawint(map.maprect.right);
              drawtext(',');
              drawint(map.maprect.bottom);
            end;
    begin
      DispMap(p.portmap);
      newline(x,y);
      drawtext('Pattern:  ');
      for k := 1 to 8 do 
        begin
          drawint(p.penpattern[k]);
          drawtext(', ');
        end;
        
      newline(x,y);
      drawtext('ColorMasks:  ');
      drawint(p.colormasks.andmask);
      drawtext(',');
      drawint(p.colormasks.ormask);
      newline(x,y);
      
      drawtext('PenLoc:  ');
      drawint(p.penloc.x);
      drawtext(',');
      drawint(p.penloc.y);
      
      newline(x,y);
      drawtext('PenSize:  ');
      drawint(p.penwidth);
      drawtext(',');
      drawint(p.penheight);
      
      newline(x,y);
      drawtext('PenMode:  ');
      drawint(ord(p.penmode));
      
      newline(x,y);
      drawtext('TextBG:  ');
      drawint(p.textback);
      
      newline(x,y);
      drawtext('TextFont:  ');
      drawint(p.textfont);
    end;


procedure       DispWinfo  (    x,y : integer;
                            var w : winfo );
{ Prints the contents of winfo W into file F. }
{ Very useful while debugging }

    var
        orig_y : integer;
        temp : integer;
    
    begin
      hidecursor;
      
      orig_y := y;
      with w do 
        begin
          moveto(x,y);
          temp := pointerto(w);
          drawtext('This winfo at:  ');
          drawint(temp);
          
          newline(x,y);
          drawtext('Window ID:  ');
          drawint(window_id);
          
          newline(x,y);
          drawtext('Dialog:  ');
          if Dialog then drawtext('is true.')
          else drawtext('is false.');
                           
          newline(x,y);
          drawtext('goawaybox:  ');
          if goawaybox then drawtext('is true.')
          else drawtext('is false.');
                           
          newline(x,y);
          drawtext('GrowBox:  ');
          if GrowBox then drawtext('is true.')
          else drawtext('is false.');

          newline(x,y);
          drawtext('Title is:  ');
          drawtext(title_ptr^);
          
          newline(x,y);
          drawtext('HActive:  ');
          if HActive then drawtext('is true.')
          else drawtext('is false.');
                           
          newline(x,y);
          drawtext('HThumb:  ');
          if HThumb then drawtext('is true.')
          else drawtext('is false.');
                           
          newline(x,y);
          drawtext('HScrollBar:  ');
          if HScrollBar then drawtext('is true.')
          else drawtext('is false.');
                           
          newline(x,y);
          drawtext('VActive:  ');
          if VActive then drawtext('is true.')
          else drawtext('is false.');
                           
          newline(x,y);
          drawtext('VThumb:  ');
          if VThumb then drawtext('is true.')
          else drawtext('is false.');
                           
          newline(x,y);
          drawtext('VScrollBar:  ');
          if VScrollBar then drawtext('is true.')
          else drawtext('is false.');
                           
          newline(x,y);
          drawtext('HThumbMax:  ');
          drawint(HThumbMax);
                           
          newline(x,y);
          drawtext('HThumbPos:  ');
          drawint(HThumbPos);
                           
          newline(x,y);
          drawtext('VThumbMax:  ');
          drawint(VThumbMax);
                           
          newline(x,y);
          drawtext('VThumbPos:  ');
          drawint(VThumbPos);
          
          x := x+180;
          y := orig_y;
          moveto(x,y);
          drawtext('WinOpen:  ');
          if WinOpen then drawtext('is true.')
          else drawtext('is false.');
                           

                           
          newline(x,y);
          drawtext('MinContWidth:  ');
          drawint(MinContWidth);
                           
          newline(x,y);
          drawtext('MaxContWidth:  ');
          drawint(MaxContWidth);
                           
          newline(x,y);
          drawtext('MinContLength:  ');
          drawint(MinContLength);
                           
          newline(x,y);
          drawtext('MaxContLength:  ');
          drawint(MaxContLength);
                    
                   
          newline(x,y);
          x := x + 15;
          DispPort(x,y,windowport);
          
          x := x + 180;
          y := orig_y;
          moveto(x,y);
          moveleft(nextwinfo,temp,2);
          drawtext('Next Winfo at ');
          drawint(temp);
        end; { with }
      
      showcursor;
      
    end; { Disp Winfo }

procedure       PrintPort (var f : text;
                           var p : grafport);

{ Prints the values in the port P to the file f }
{ Very useful when debugging. }
    var 
        k : integer;
    
        procedure     printmap(var map : mapinfo);
            begin
              writeln(f,'ViewX, ViewY:  ',map.viewloc.x,',',map.viewloc.y);
              writeln(f,'Mapbits:  ',map.mapbits);
              writeln(f,'Mapwidth:  ',map.mapwidth);
              writeln(f,'ClipRect:  ',map.maprect.left,',',map.maprect.top);
              writeln(f,'ClipRect:  ',map.maprect.right,',',map.maprect.bottom);
            end;
    begin
      PrintMap(p.portmap);
      write(f,'Pattern:  ');
      for k := 1 to 8 do write(f,p.penpattern[k],', ');
      writeln(f);
      writeln(f,'ColorMasks:  ',p.colormasks.andmask,',',p.colormasks.ormask);
      writeln(f,'PenLoc:  ',p.penloc.x,',',p.penloc.y);
      writeln(f,'PenWidth:  ',p.penwidth);
      writeln(f,'PenHeight:  ',p.penheight);
      writeln(f,'PenMode:  ',ord(p.penmode));
      writeln(f,'TextBG:  ',p.textback);
      writeln(f,'TextFont:  ',p.textfont);
    end;


procedure       PrintWinfo (var f : text;
                            var w : winfo );
{ Prints the contents of winfo W into file F. }
{ Very useful while debugging }

    var
        temp : integer;
    
    
    procedure Part1;
    begin
      with w do 
        begin
          writeln(f);
          temp := pointerto(w);
          writeln(f,'This winfo at:  ',temp);
          
          writeln(f,'Window ID:  ',window_id);
          
          write (f,'Dialog:  ');
          if Dialog then writeln(f,'is true.')
          else writeln(f,'is false.');
                           
          write (f,'goawaybox:  ');
          if goawaybox then writeln(f,'is true.')
          else writeln(f,'is false.');
                           
          write (f,'GrowBox:  ');
          if GrowBox then writeln(f,'is true.')
          else writeln(f,'is false.');

          writeln(f,'Title is:  ',title_ptr^);
          
          write (f,'HActive:  ');
          if HActive then writeln(f,'is true.')
          else writeln(f,'is false.');
                           
          write (f,'HThumb:  ');
          if HThumb then writeln(f,'is true.')
          else writeln(f,'is false.');
                           
          write (f,'HScrollBar:  ');
          if HScrollBar then writeln(f,'is true.')
          else writeln(f,'is false.');
                           
          write (f,'VActive:  ');
          if VActive then writeln(f,'is true.')
          else writeln(f,'is false.');
                           
          write (f,'VThumb:  ');
          if VThumb then writeln(f,'is true.')
          else writeln(f,'is false.');
                           
          write (f,'VScrollBar:  ');
          if VScrollBar then writeln(f,'is true.')
          else writeln(f,'is false.');
                           
        end; {with}
        
    end; {Part1}
    
    
    procedure  Part2;
    begin
      with w do 
        begin
                           
          writeln(f,'HThumbMax:  ',HThumbMax);
          writeln(f,'HThumbPos:  ',HThumbPos);
          writeln(f,'VThumbMax:  ',VThumbMax);
          writeln(f,'VThumbPos:  ',VThumbPos);
          
          write (f,'WinOpen:  ');
          if WinOpen then writeln(f,'is true.')
          else writeln(f,'is false.');
                           
          
          writeln(f,'MinContWidth:  ',MinContWidth);
          writeln(f,'MaxContWidth:  ',MaxContWidth);
          writeln(f,'MinContLength:  ',MinContLength);
          writeln(f,'MaxContLength:  ',MaxContLength);
          
          writeln(f);
          
          PrintPort(f,windowport);
          
          writeln(f);
          
          moveleft(nextwinfo,temp,2);
          
          writeln(f,'Next Winfo at ',temp);
        end; { with }
        
    end;
    
    begin
      Part1;
      Part2
    end;

procedure       Prt_Current_Port (var f : text);
    var
       p : record
        case boolean of
         true : (i : integer);
         false : (p : ^grafport);
        end;
    begin
      GetPort(p.i);
      PrintPort(f,p.p^);
    end;


(*
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$$$   END OF FILE : TK - TK.PART2.TEXT
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

File brought to you by:

Apple Macintosh Apple II Pascal Disk Image Dumper 1.0.0 (16 May 2004)
David T Craig (Santa Fe, New Mexico, USA)
shirlgato@cybermesa.com / dcraig@cyberwolf.com

Sunday, June 20, 2004 -- 1:52:10 PM
*)

